PsL Monthly 1993 December/PSL Monthly Shareware CD-ROM (December 1993).iso/prgmming/dos/pascal/run123.com/T5DOS.PAS

Pascal/Delphi Source File | 1989-03-16 | 11.0 KB | 312 lines

{═══════════════════════════════ T5DOS.PAS ═══════════════════════════════}
{ ───────────  Turbo 4.0/5.0 subprocess demonstration program  ────────── }
{                 Copyright (c) 1989  Richard W. Prescott                 }
{ This Unit provides routines which are Call & Result compatible with     }
{ GetEnv, FSearch, and SwapVectors from the Turbo 5.0 DOS Unit.  They     }
{ are used in the main program RUN123.PAS and are provided here for the   }
{ benefit of Turbo 4.0 Users and for those interested in seeing how such  }
{ routines might be implemented.  These are independent implementations   }
{ developed without reference to the run-time source code and without     }
{ disassembling Turbo 5.0 object code.                                    }
{ Users familiar with EXTERNAL Assembly routines should note that with    }
{ TP&Asm you can have multiple Assembly Proc/Functions in the same source }
{ file with Smart-Linking on an individual Procedure basis.  This is in   }
{ contrast to External OBJ files with multiple Assembly Proc/Functions    }
{ which are linked on an All-or-Nothing basis.  Using TP&Asm permits the  }
{ development of efficient libraries of Assembly procedures without       }
{ littering your system with an infinite number of source and OBJ files.  }
{═════════════════════════════════════════════════════════════════════════}
{ This Unit was compiled and assembled using Turbo Pascal Version 4.0     }
{ and TP&Asm Version 2 ß.  TP&Asm provides an integrated compile-time     }
{ assembler within the Turbo development environment (and the command     }
{ line compiler TPC), resulting in an ASSEMBLY Development Environment    }
{ which is identical to your PASCAL Development Environment.              }
{                                                                         }
{ TP&Asm Version 2.0 will be available from me for $49 plus $3 P&H.  The  }
{ current Beta Test Version 2 ß is available now for $39 plus $3 P&H,     }
{ with a free upgrade to 2.0 when it becomes available.                   }
{          Please see the README file for further information.            }
{═════════════════════════════════════════════════════════════════════════}

Unit T5DOS;

interface

  TYPE PathStr = STRING[79];

  FUNCTION GetEnv(EnvVar: STRING): STRING;
  FUNCTION FSearch(Path: PathStr; DirList: STRING): PathStr;
  PROCEDURE SwapVectors;

implementation


{════════════════════════════════ GetEnv ═════════════════════════════════}
{ Call with the name of an Environment Variable (upper/lower/mixed Case), }
{ excluding the "=".  Returns the same string which would be displayed by }
{ the DOS "Set" command, beginning with the first Char following the "=". }
{════════════════════════════════ GetEnv ═════════════════════════════════}
FUNCTION GetEnv(EnvVar: STRING): STRING;
BEGIN
  Assembly

  ResultStr EQU D[Bp+10]; pointer to function result, determined via EXAMINE

;- 1. Set Env Pointer Es:Di (EnvSeg := MemW[PrefixSeg:$2C];)
  Mov Es,PrefixSeg
  Es Mov Es,[02C]
  Xor Di,Di
  Cld                 ; All String Operations will be FORWARD

;- 2. convert EnvVar to UpCase and set Cx
  Push Ds,Ss
  Pop Ds              ; Point Ds:Si to local copy of EnvVar
  Lea Si,EnvVar
  Xor Ah,Ah
  LodSB
  Xchg Ax,Cx          ; Set counter to Length(EnvVar)
  Mov Dx,Cx           ; save count
  Mov Bx,Si           ; and start offset
  jCXZ ExitEmpty
 L0:
  And B[Si],0DF       ; capitalize
  Inc Si
  Loop L0
;- set to go with capitalized EnvVar

;- 3. exit if FIRST byte of current Env string is 0
 CheckEnvString:
  Mov Cx,Dx           ; reset count
  Mov Si,Bx           ; and start offset
  Es Cmp B[Di],0
  jZ ExitEmpty

;- 4. Else CmpSB EnvVar with current Env Pointer
  RepE CmpSB
  jNE Scan0

;- 5. Found, check for '='
  Es Cmp B[Di],'='
  jE ExitFound

;- 6. Not found: Scan for b(0) and goto 3.
 Scan0:
  Dec Di              ; back up one
  Mov Cx,07FFF        ; max env length
  Xor Al,Al           ; search for 0 byte
  RepNE ScaSB         ; leaves Di pointing immediately PAST the 0 byte
  jNE ExitEmpty       ; Env Error, report not found
  Jmp CheckEnvString  ; Repeat steps 3-6

;- 7. Found, set result & Exit
 ExitFound:
  Inc Di              ; now Es:Di points to null terminated Env String
  Push Di
  Xor Al,Al
  Mov Cx,255
  RepNE ScaSB         ; leaves Di pointing immediately PAST the 0 byte
  jNE ErrorEmpty      ; Env Error, pop Di and report not found
  Dec Di              ; adjust
  Pop Ax              ; old value of Di
  Sub Di,Ax           ; string length in Di
  Xchg Ax,Di          ; string length in Ax, restore Di
  Cmp Ax,255
  jA ExitEmpty        ; Env Error, report not found

  Push Es
  Pop Ds
  Mov Si,Di           ; now Ds:Si points to null terminated Env String

  Les Di,ResultStr    ; Load Es:Di with pointer to Function Result
  Mov Cx,Ax
  StoSB               ; store result length
  Rep MovSB           ; move result string
  Jmp Done

 ErrorEmpty:
  Pop Di              ; clear pending push
 ExitEmpty:
  Les Di,ResultStr    ; Load Es:Di with pointer to Function Result
  Xor Al,Al
  StoSB               ; store result length = 0

 Done:
  Pop Ds
  END; {Assembly}
END; {FUNCTION GetEnv}


{════════════════════════════════ FSearch ════════════════════════════════}
{ Call with the File or Path name of a file to search for, and a list of  }
{ directories to search, separated by semi-colons ";" (ie, in standard    }
{ DOS Path format).  Searches current directory first, then searches each }
{ directory or drive in DirList.  If a DirList entry consists of a Drive  }
{ only (eg "C:"), searches active directory and then root directory of    }
{ that drive.  If found, Returns the full path string (directory prefix   }
{ plus file Path) used in the successful search.  If not found, Returns   }
{ an empty string.  FSearch finds only true files (including read-only,   }
{ hidden, and system files), not Volume labels or Sub-directories.        }
{════════════════════════════════ FSearch ════════════════════════════════}
FUNCTION FSearch(Path: PathStr; DirList: STRING): PathStr;
VAR FullPath: STRING;    {- STRING[80] would suffice -}
    TryRoot:  BOOLEAN;
BEGIN
 Assembly
  ResultPath EQU D[Bp+14] ; Ptr to function result
;- 1. Initialize stuff
  Cld                 ; All String Operations will be FORWARD
  Mov TryRoot,TRUE
  Push Ds,Ss,Ss       ; save Dseg
  Pop Ds,Es           ; and point Ds & Es to Stack
  Lea Si,DirList
  Inc Si
  Push Si             ; save current position within DirList
  Lea Di,FullPath
  Mov Bx,Di           ; Save, points to FullPath length byte
  Inc Di
  Mov Dx,Di           ; Save start of AsciiZ, also used by function $43

;- 2. Append Path to FullPath
 AppendPath:
  Lea Si,Path
  Xor Ax,Ax
  LodSB
  Xchg Cx,Ax
  Mov Ax,Di           ; End of DosPath Prefix
  Add Ax,Cx           ; Plus length of 'Path'
  Sub Ax,Dx           ; Minus start of AsciiZ = length of Full Path
  Cmp Ax,79           ; Max length of a PathStr
  jA NotYetFound      ; IF Above, SKIP Move, go try next DosPath Prefix
  Mov B[Bx],Al        ; Put in FullPath length byte
  Rep MovSB           ; Append Path
  Xor Al,Al
  StoSB               ; Make AsciiZ

;- 3. Get File Attr to test for file existence
  Mov Ax,$4300        ; Note - Ds:Dx is already set, points to the AsciiZ
  Int 21h
  jC NotYetFound      ; Only possible failure is Path/File not found
  Test Cx,0018
  jZ ExitFound        ; Treat VolumeLabels and SubDirs as not found

;- 4. Not yet found - get next DosPath Prefix from DirList
 NotYetFound:
  Xor Ax,Ax
  Lea Si,DirList
  LodSB               ; Load Length
  Pop Si              ; current position in DirList
  Lea Cx,DirList
  Inc Cx              ; start offset of DirList
  Add Cx,Ax           ; Add length of DirList
  Sub Cx,Si           ; Minus current Pos = Characters remaining
  jBE ExitEmpty       ; End of DirList, still not found
  Mov Di,Dx           ; = offset of AsciiZ FullPath to load
 L0:                  ; Get next DosPath Prefix
  LodSB
  Cmp Al,';'
  jE >L1
  StoSB               ; store to FullPath at Es:Di
  Loop L0
  Inc Si              ; Adjust Si in case LAST DosPath Prefix is Drive-Only
 L1:
;- for drive-only prefix eg 'D:', need to try both 'D:' and 'D:\'
  Cmp B[Di-1],':'
  jNE >L2
  Xor TryRoot,TRUE
 ;- First Pass Toggles to FALSE:
  jNZ >L2             ; NZ = 2nd Pass; add trailing '\' to try root dir
  Sub Si,3            ; ELSE reset Si for 2nd Pass,
  Push Si             ; Save,
  Jmp AppendPath      ; and try using Drive-Only

 L2:
;- see if trailing '\' must be added
  Push Si             ; Si points PAST the semi-colon to next DosPath Prefix
  Mov Al,'\'
  Cmp B[Di-1],Al
  IF NE StoSB         ; add trailing '\' if nec
  Jmp AppendPath      ; Repeat steps 2-4

 ExitEmpty:
  Mov B[Bx],0         ; set zero length, don't need to POP Si
  Jmp PutInResult

 ExitFound:
  Pop Si              ; clear pending PUSH

;- 6. put in function result
 PutInResult:
  Lea Si,FullPath
  Les Di,ResultPath
  Xor Ax,Ax
  LodSB
  Mov Cx,Ax           ; set move count
  StoSB               ; mov length byte
  IF NCXZ Rep MovSB   ; and move path string

  Pop Ds

 END; {Assembly}
END; {FUNCTION FSearch}


{══════════════════════════════ SwapVectors ══════════════════════════════}
{ Turbo 4.0 takes over 5 interrupt vectors: 00h, 02h, 23h, 24h, and 75h.  }
{ The original values of these vectors are stored in the System Unit VARs }
{ SaveInt00, SavInt02, etc.  This procedure interchanges the saved values }
{ with the current values of the interrupt vectors.  SwapVectors should   }
{ be called immediately before and after calling the DOS Unit Exec Proc.  }
{══════════════════════════════ SwapVectors ══════════════════════════════}
  Internal SwapV
;- SwapVectors has no parameters -
;- Use INTERNAL to eliminate standard Pascal Entry/Exit Code

  CODE Segment

  SwapVectors PROC FAR

    Mov Al,00h
    Mov Si,Offset SAVEINT00
    Call SwapVec
    Mov Al,02h
    Mov Si,Offset SAVEINT02
    Call SwapVec
    Mov Al,23h
    Mov Si,Offset SAVEINT23
    Call SwapVec
    Mov Al,24h
    Mov Si,Offset SAVEINT24
    Call SwapVec
    Mov Al,75h
    Mov Si,Offset SAVEINT75
    Call SwapVec

    RET

   SwapVec PROC NEAR
   ;- Called with  Al = Intr Number  and  Si = Offset SaveIntXX

    Mov Ah,035h    ; Get Interrupt Vector
    Int 21h        ;  .. Sets Es:Bx to Intr Vector

   ;- Leave Ds addressing Turbo DSeg for following memory refs
    Mov Cx,[Si+2]  ; Load SaveIntXX into Cx:Dx
    Mov Dx,[Si]    ;  for subsequent Set Vector Call
    Mov [Si+2],Es  ; Store Es:Bx from previous
    Mov [Si],Bx    ;  Get Vector Call into SaveIntXX

   ;- Now set Ds for Set Vector Call
    Push Ds
    Mov Ds,Cx
    Mov Ah,025h    ; Set Interrupt Vector
    Int 21h        ;  .. Sets Intr Vector to Ds:Dx
    Pop Ds
    Ret            ; Return from SwapVec
   SwapVec ENDP

  SwapVectors ENDP
  CODE ENDS
  END {- Internal SwapV -}

END.